home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DATETIME / TIMERS / TIMERS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-10-22  |  2KB  |  73 lines
  1. (******************************************************************************
  2.   TIMERS.PAS  - Routines which intercept 55ms PC interupt $1C to do timing
  3.   Author      - Richard Mullen
  4.   Date          - 10/20/90
  5. ******************************************************************************)
  6. {$R+}     { Range checking on            }
  7. {$B-}     { Boolean complete evaluation off  }
  8. {$S+}     { Stack checking on            }
  9. {$I-}     { I/O checking off            }
  10. {$V-}     { Relaxed variable checking        }
  11. {$N-}     { No numeric coprocessor        }
  12. {$E-}     { No numeric coprocessor emulation }
  13.  
  14. unit Timers;
  15.  
  16. INTERFACE
  17.  
  18. var
  19. TimerCounter        : word;
  20.  
  21. procedure InitTimerInterupt;
  22. procedure ReleaseTimerInterupt;
  23.  
  24. IMPLEMENTATION
  25.  
  26. uses dos;
  27.  
  28. var
  29. OldVector : pointer;
  30.  
  31. (*****************************************************************************)
  32.  
  33. {$l timers}
  34. procedure CallRoutine (Vector : pointer); external;
  35.  
  36. (*****************************************************************************)
  37.  
  38. procedure TimerInterupt;
  39.    interrupt;
  40.    begin
  41.  
  42.    CallRoutine (OldVector);               { Run old interupt routine }
  43.  
  44.    if TimerCounter > 0 then dec (TimerCounter); { TimerCounter is decremented }
  45.    end;                     {  every 55 ms, if not = 0    }
  46.  
  47. (*****************************************************************************)
  48.  
  49. procedure ReleaseTimerInterupt;
  50.    begin
  51.    inline ($FA);
  52.    SetIntVec ($1C, OldVector);
  53.    inline ($FB);
  54.    end;
  55.  
  56. (*****************************************************************************)
  57.  
  58. procedure InitTimerInterupt;
  59.    begin
  60.    GetIntVec ($1C, OldVector);
  61.    inline ($FA);
  62.    SetIntVec ($1C, @TimerInterupt);
  63.    inline ($FB);
  64.    end;
  65.  
  66. (*****************************************************************************)
  67. (************************   Initialization  **********************************)
  68.  
  69. begin
  70. TimerCounter  := 0;
  71. end.
  72.  
  73.